home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / borland / bgvga256.zip / VGADEMO.PAS < prev   
Pascal/Delphi Source File  |  1989-05-31  |  41KB  |  1,494 lines
  1. program BGIDemo;
  2. {
  3.  
  4.   Turbo Pascal Borland Graphics Interface (BGI) demonstration
  5.   program. This program shows how to use many features of
  6.   the Graph unit.
  7.  
  8.   Copyright (c) 1985-89 by Borland International, Inc.
  9.  
  10. }
  11.  
  12. uses
  13.   Crt, Dos, Graph;
  14.  
  15.  
  16. const
  17.   { The five fonts available }
  18.   Fonts : array[0..4] of string[13] =
  19.   ('DefaultFont', 'TriplexFont', 'SmallFont', 'SansSerifFont', 'GothicFont');
  20.  
  21.   { The five predefined line styles supported }
  22.   LineStyles : array[0..4] of string[9] =
  23.   ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn', 'UserBitLn');
  24.  
  25.   { The twelve predefined fill styles supported }
  26.   FillStyles : array[0..11] of string[14] =
  27.   ('EmptyFill', 'SolidFill', 'LineFill', 'LtSlashFill', 'SlashFill',
  28.    'BkSlashFill', 'LtBkSlashFill', 'HatchFill', 'XHatchFill',
  29.    'InterleaveFill', 'WideDotFill', 'CloseDotFill');
  30.  
  31.   { The two text directions available }
  32.   TextDirect : array[0..1] of string[8] = ('HorizDir', 'VertDir');
  33.  
  34.   { The Horizontal text justifications available }
  35.   HorizJust  : array[0..2] of string[10] = ('LeftText', 'CenterText', 'RightText');
  36.  
  37.   { The vertical text justifications available }
  38.   VertJust   : array[0..2] of string[10] = ('BottomText', 'CenterText', 'TopText');
  39.  
  40. var
  41.   GraphDriver : integer;  { The Graphics device driver }
  42.   GraphMode   : integer;  { The Graphics mode value }
  43.   MaxX, MaxY  : word;     { The maximum resolution of the screen }
  44.   ErrorCode   : integer;  { Reports any graphics errors }
  45.   MaxColor    : word;     { The maximum color value available }
  46.   OldExitProc : Pointer;  { Saves exit procedure address }
  47.  
  48. {$F+}
  49. procedure MyExitProc;
  50. begin
  51.   ExitProc := OldExitProc; { Restore exit procedure address }
  52.   CloseGraph;              { Shut down the graphics system }
  53. end; { MyExitProc }
  54. {$F-}
  55.  
  56. {$F+}
  57. function DetectVGA256 : integer;
  58. { Detects VGA or MCGA video cards }
  59. var
  60.   DetectedDriver : integer;
  61.   SuggestedMode  : integer;
  62. begin
  63.   DetectGraph(DetectedDriver, SuggestedMode);
  64.   if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
  65.     DetectVGA256 := 0        { Default video mode = 0 }
  66.   else
  67.     DetectVGA256 := grError; { Couldn't detect hardware }
  68. end; { DetectVGA256 }
  69. {$F-}
  70.  
  71. var
  72.   AutoDetectPointer : pointer;
  73.  
  74. procedure Initialize;
  75. { Initialize graphics and report any errors that may occur }
  76. var
  77.   InGraphicsMode : boolean; { Flags initialization of graphics mode }
  78.   PathToDriver   : string;  { Stores the DOS path to *.BGI & *.CHR }
  79. begin
  80.   { when using Crt and graphics, turn off Crt's memory-mapped writes }
  81.   DirectVideo := False;
  82.   OldExitProc := ExitProc;                { save previous exit proc }
  83.   ExitProc := @MyExitProc;                { insert our exit proc in chain }
  84.   PathToDriver := '';
  85.   repeat
  86.  
  87.     AutoDetectPointer := @DetectVGA256;   { Point to detection routine }
  88.     GraphDriver := InstallUserDriver('VGA256', AutoDetectPointer);
  89.     GraphDriver := Detect;
  90.  
  91.     InitGraph(GraphDriver, GraphMode, PathToDriver);
  92.     ErrorCode := GraphResult;             { preserve error return }
  93.     if ErrorCode <> grOK then             { error? }
  94.     begin
  95.       Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  96.       if ErrorCode = grFileNotFound then  { Can't find driver file }
  97.       begin
  98.         Writeln('Enter full path to BGI driver or type <Ctrl-Break> to quit:');
  99.         Readln(PathToDriver);
  100.         Writeln;
  101.       end
  102.       else
  103.         Halt(1);                          { Some other error: terminate }
  104.     end;
  105.   until ErrorCode = grOK;
  106.   Randomize;                { init random number generator }
  107.   MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  108.   MaxX := GetMaxX;          { Get screen resolution values }
  109.   MaxY := GetMaxY;
  110. end; { Initialize }
  111.  
  112. function Int2Str(L : LongInt) : string;
  113. { Converts an integer to a string for use with OutText, OutTextXY }
  114. var
  115.   S : string;
  116. begin
  117.   Str(L, S);
  118.   Int2Str := S;
  119. end; { Int2Str }
  120.  
  121. function RandColor : word;
  122. { Returns a Random non-zero color value that is within the legal
  123.   color range for the selected device driver and graphics mode.
  124.   MaxColor is set to GetMaxColor by Initialize }
  125. begin
  126.   RandColor := Random(MaxColor)+1;
  127. end; { RandColor }
  128.  
  129. procedure DefaultColors;
  130. { Select the maximum color in the Palette for the drawing color }
  131. begin
  132.   SetColor(White);
  133. end; { DefaultColors }
  134.  
  135. procedure DrawBorder;
  136. { Draw a border around the current view port }
  137. var
  138.   ViewPort : ViewPortType;
  139. begin
  140.   DefaultColors;
  141.   SetLineStyle(SolidLn, 0, NormWidth);
  142.   GetViewSettings(ViewPort);
  143.   with ViewPort do
  144.     Rectangle(0, 0, x2-x1, y2-y1);
  145. end; { DrawBorder }
  146.  
  147. procedure FullPort;
  148. { Set the view port to the entire screen }
  149. begin
  150.   SetViewPort(0, 0, MaxX, MaxY, ClipOn);
  151. end; { FullPort }
  152.  
  153. procedure MainWindow(Header : string);
  154. { Make a default window and view port for demos }
  155. begin
  156.   DefaultColors;                           { Reset the colors }
  157.   ClearDevice;                             { Clear the screen }
  158.   SetTextStyle(DefaultFont, HorizDir, 1);  { Default text font }
  159.   SetTextJustify(CenterText, TopText);     { Left justify text }
  160.   FullPort;                                { Full screen view port }
  161.   OutTextXY(MaxX div 2, 2, Header);        { Draw the header }
  162.   { Draw main window }
  163.   SetViewPort(0, TextHeight('M')+4, MaxX, MaxY-(TextHeight('M')+4), ClipOn);
  164.   DrawBorder;                              { Put a border around it }
  165.   { Move the edges in 1 pixel on all sides so border isn't in the view port }
  166.   SetViewPort(1, TextHeight('M')+5, MaxX-1, MaxY-(TextHeight('M')+5), ClipOn);
  167. end; { MainWindow }
  168.  
  169. procedure StatusLine(Msg : string);
  170. { Display a status line at the bottom of the screen }
  171. begin
  172.   FullPort;
  173.   DefaultColors;
  174.   SetTextStyle(DefaultFont, HorizDir, 1);
  175.   SetTextJustify(CenterText, TopText);
  176.   SetLineStyle(SolidLn, 0, NormWidth);
  177.   SetFillStyle(EmptyFill, 0);
  178.   Bar(0, MaxY-(TextHeight('M')+4), MaxX, MaxY);      { Erase old status line }
  179.   Rectangle(0, MaxY-(TextHeight('M')+4), MaxX, MaxY);
  180.   OutTextXY(MaxX div 2, MaxY-(TextHeight('M')+2), Msg);
  181.   { Go back to the main window }
  182.   SetViewPort(1, TextHeight('M')+5, MaxX-1, MaxY-(TextHeight('M')+5), ClipOn);
  183. end; { StatusLine }
  184.  
  185. procedure WaitToGo;
  186. { Wait for the user to abort the program or continue }
  187. const
  188.   Esc = #27;
  189. var
  190.   Ch : char;
  191. begin
  192.   StatusLine('Esc aborts or press a key...');
  193.   repeat until KeyPressed;
  194.   Ch := ReadKey;
  195.   if Ch = Esc then
  196.     Halt(0)                           { terminate program }
  197.   else
  198.     ClearDevice;                      { clear screen, go on with demo }
  199. end; { WaitToGo }
  200.  
  201. procedure GetDriverAndMode(var DriveStr, ModeStr : string);
  202. { Return strings describing the current device driver and graphics mode
  203.   for display of status report }
  204. begin
  205.   DriveStr := GetDriverName;
  206.   ModeStr := GetModeName(GetGraphMode);
  207. end; { GetDriverAndMode }
  208.  
  209. procedure ReportStatus;
  210. { Display the status of all query functions after InitGraph }
  211. const
  212.   X = 10;
  213. var
  214.   ViewInfo   : ViewPortType;     { Parameters for inquiry procedures }
  215.   LineInfo   : LineSettingsType;
  216.   FillInfo   : FillSettingsType;
  217.   TextInfo   : TextSettingsType;
  218.   Palette    : PaletteType;
  219.   DriverStr  : string;           { Driver and mode strings }
  220.   ModeStr    : string;
  221.   Y          : word;
  222.  
  223. procedure WriteOut(S : string);
  224. { Write out a string and increment to next line }
  225. begin
  226.   OutTextXY(X, Y, S);
  227.   Inc(Y, TextHeight('M')+2);
  228. end; { WriteOut }
  229.  
  230. begin { ReportStatus }
  231.   GetDriverAndMode(DriverStr, ModeStr);   { Get current settings }
  232.   GetViewSettings(ViewInfo);
  233.   GetLineSettings(LineInfo);
  234.   GetFillSettings(FillInfo);
  235.   GetTextSettings(TextInfo);
  236.   GetPalette(Palette);
  237.  
  238.   Y := 4;
  239.   MainWindow('Status report after InitGraph');
  240.   SetTextJustify(LeftText, TopText);
  241.   WriteOut('Graphics device    : '+DriverStr);
  242.   WriteOut('Graphics mode      : '+ModeStr);
  243.   WriteOut('Screen resolution  : (0, 0, '+Int2Str(GetMaxX)+', '+Int2Str(GetMaxY)+')');
  244.   with ViewInfo do
  245.   begin
  246.     WriteOut('Current view port  : ('+Int2Str(x1)+', '+Int2Str(y1)+', '+Int2Str(x2)+', '+Int2Str(y2)+')');